home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / sh5x / sh56b.d64 / matrix 2.6 (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  15KB  |  698 lines
  1. 100 REM   *****************************
  2. 110 REM   * V 2.6                     *
  3. 120 REM   * MATRIX RECHNER MIT EDITOR *
  4. 130 REM   *                           *
  5. 140 REM   *  (C)1988 VIKTOR K.ANDOR   *
  6. 150 REM   *                           *
  7. 160 REM   *   EDUARD MOERIKE-STR.6    *
  8. 170 REM   *   2970 EMDEN TEL:44736    *
  9. 180 REM   *                           *
  10. 190 REM   *****************************
  11. 200 :
  12. 210 :
  13. 220 POKE 55,226:POKE 56,159:CLR:POKE 788,52
  14. 230 FOR I=0 TO 25:READ X:POKE 40931+I,X:NEXT I
  15. 240 DATA 032,253,174,032,158,183,138,072
  16. 250 DATA 032,253,174,032,158,183,104,168
  17. 260 DATA 024,032,240,255,032,253,174,076
  18. 270 DATA 164,170
  19. 280 AT=40931
  20. 290 DEFFNE(Y)=INT(1E7*Y+.5)/1E7
  21. 300 FOR I=0 TO 42:READ A:POKE 24576+I,A:NEXT I
  22. 310 DATA 169,000,160,004,133,250,132,251
  23. 320 DATA 169,232,160,007,133,252,132,253
  24. 330 DATA 169,160,133,254,160,000,165,254
  25. 340 DATA 145,250,230,250,208,002,230,251
  26. 350 DATA 165,250,197,252,165,251,229,253
  27. 360 DATA 144,230,096
  28. 370 POKE 53280,11:POKE 53281,0:POKE 53265,11:PRINT"[129][147]":SYS 24576
  29. 380 B1$="[146][159][221] [221] [221] [221] [221] [221] [221] [221] [221] [221] [221]"
  30. 390 B2$="[146][159][171][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][179]"
  31. 400 B0$="[129]":B3$="":B4$="[158]":B5$="":B6$="[154]":B8$="+ - * /?"
  32. 410 B9$="Q   X ?  Y?"
  33. 420 F1$="0102030405060708091011121314151617181920"
  34. 430 V1$="0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 2 "
  35. 440 V2$="1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 "
  36. 450 PRINTB0$"    0 0 0 0 0 0 0 0 0 1  VIKTOR K.ANDOR"
  37. 460 PRINTB0$"    1 2 3 4 5 6 7 8 9 0       1988"
  38. 470 PRINTB0$"   [146][159][176][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][174]"
  39. 480 PRINTB0$" 01";B1$
  40. 490 PRINTB0$"   ";B2$
  41. 500 PRINTB0$" 02";B1$
  42. 510 PRINTB0$"   ";B2$
  43. 520 PRINTB0$" 03";B1$
  44. 530 PRINTB0$"   ";B2$
  45. 540 PRINTB0$" 04";B1$
  46. 550 PRINTB0$"   ";B2$
  47. 560 PRINTB0$" 05";B1$
  48. 570 PRINTB0$"   ";B2$
  49. 580 PRINTB0$" 06";B1$
  50. 590 PRINTB0$"   ";B2$
  51. 600 PRINTB0$" 07";B1$
  52. 610 PRINTB0$"   ";B2$
  53. 620 PRINTB0$" 08";B1$
  54. 630 PRINTB0$"   ";B2$
  55. 640 PRINTB0$" 09";B1$
  56. 650 PRINTB0$"   ";B2$
  57. 660 PRINTB0$" 10";B1$
  58. 670 PRINTB0$"   [146][159][173][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][189]"
  59. 680 GOSUB 6860
  60. 690 FOR I=4 TO 21 STEP 2:SYS AT,26,I,B3$"            ":NEXT I
  61. 700 PRINT"[159]"
  62. 710 SYS AT,25,02,"[176][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  63. 720 SYS AT,25,22,"[173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  64. 730 GOSUB 6860
  65. 740 FOR I=4 TO 21 STEP 2:SYS AT,26,I,B3$"            ":NEXT I
  66. 750 PRINT"[159]"
  67. 760 FOR I=3 TO 21 :SYS AT,25,I,"[221]":SYS AT,38,I,"[221]":NEXT I:POKE 53265,27
  68. 770 DIM Z(1,20,20),C(20,20),M(1,20,20),W(20):MA=0:TR=1
  69. 780 GET A$:IF A$=""THEN 780
  70. 790 IF A$="I" THEN 1060
  71. 800 IF A$="C" THEN 1950
  72. 810 IF A$="D" THEN 2220
  73. 820 IF A$="E" THEN GOSUB 6970:GOTO 910
  74. 830 IF A$="Q" THEN CL=0:GOSUB 6770
  75. 840 IF A$="M" THEN 2860
  76. 850 IF A$="R" THEN 2970
  77. 860 IF A$="S" THEN 3100
  78. 870 IF A$="W" THEN 3240
  79. 880 IF A$="-" THEN 3600
  80. 890 GOTO 780
  81. 900 :
  82. 910 GET A$:IF A$=""THEN 910
  83. 920 IF A$="+" THEN 3700
  84. 930 IF A$="-" THEN 3830
  85. 940 IF A$="*" THEN 3960
  86. 950 IF A$="/" THEN 4290
  87. 960 IF A$="Q" THEN GOSUB 6860:K=0:GOTO 780
  88. 970 IF A$="I" THEN 4200
  89. 980 IF A$="D" THEN 4070
  90. 990 IF A$="T" THEN 5550
  91. 1000 IF A$="S"THEN 5710
  92. 1010 IF A$="_"THEN 3350
  93. 1020 GOTO 910
  94. 1030 :
  95. 1040 REM INPUT
  96. 1050 :
  97. 1060 SYS AT,26,3,B3$;B9$:O=5
  98. 1070 GET A$:IF A$=""THEN 1070
  99. 1080 IF A$="X" THEN 1150
  100. 1090 IF A$="Y" THEN 1290
  101. 1100 IF A$="Q" THEN 1400
  102. 1110 GOTO 1070
  103. 1120 :
  104. 1130 REM INPUT X
  105. 1140 :
  106. 1150 GOSUB 6410
  107. 1160 SYS AT,26,3,B3$"    "B4$"MATRIX X":SYS AT,1,0,"X"
  108. 1170 GOSUB 1430:GOSUB 1490:GOSUB 6550
  109. 1180 MX=VAL(M$):F=MX
  110. 1190 GOSUB 1440:GOSUB 1490:GOSUB 6550
  111. 1200 NX=VAL(M$):V=NX
  112. 1210 GOSUB 1460
  113. 1220 IF W=1 THEN 1170
  114. 1230 KX=MX:KY=NX:P=MX:R=NX
  115. 1240 DA=MA
  116. 1250 GOTO 1390
  117. 1260 :
  118. 1270 REM INPUT Y
  119. 1280 :
  120. 1290 GOSUB 6410
  121. 1300 SYS AT,26,3,B3$"    "B4$"MATRIX Y":SYS AT,1,0,"Y"
  122. 1310 GOSUB 1430:GOSUB 1490:GOSUB 6550
  123. 1320 MY=VAL(M$):F=MY
  124. 1330 GOSUB 1440:GOSUB 1490:GOSUB 6550
  125. 1340 NY=VAL(M$):V=NY
  126. 1350 GOSUB 1460
  127. 1360 IF W=1 THEN 1310
  128. 1370 KX=MY:KY=NY:P=MY:R=NY
  129. 1380 DA=TR
  130. 1390 XY=5:GOSUB 6460:GOSUB 6550:GOSUB 5360
  131. 1400 SYS AT,26,3,B3$"I = MATRIX  "
  132. 1410 GOTO 780
  133. 1420 :
  134. 1430 SYS AT,3,23,B0$"M=?":SA=2:RETURN
  135. 1440 SYS AT,3,23,B0$"N=?":SA=2:RETURN
  136. 1450 :
  137. 1460 IF F>20 OR V>20 OR F<1 OR V<1 THEN GOSUB 6370:W=1:RETURN
  138. 1470 W=0:RETURN
  139. 1480 :
  140. 1490 M$="":SZ=0
  141. 1500 GET N$:IF N$=""THEN 1500
  142. 1510 IF ASC(N$)=13 THEN RETURN
  143. 1520 IF ASC(N$)=20 AND SZ>=1 THEN SZ=SZ-1:M$=LEFT$(M$,SZ):GOTO 1570
  144. 1530 IF ASC(N$)=69 OR ASC(N$)=45 OR ASC(N$)=46 THEN 1550
  145. 1540 IF ASC(N$)>57 OR ASC(N$)<48 THEN 1500
  146. 1550 M$=M$+N$:SZ=SZ+1
  147. 1560 IF SZ>SA THEN SZ=SA:M$=LEFT$(M$,SZ)
  148. 1570 GOSUB 1610
  149. 1580 SYS AT,O,23,B0$;M$
  150. 1590 GOTO 1500
  151. 1600 :
  152. 1610 SYS AT,O,23,B0$"                "
  153. 1620 RETURN
  154. 1630 :
  155. 1640 IF F1>3  AND Y<=10 THEN GOSUB 1760:Y=Y-1:F1=F1-2:GOTO 2560
  156. 1650 IF F1>3  AND Y>1   THEN Y=Y-1:Y1=Y-10:GOSUB 1800:GOTO 2560
  157. 1660 GOTO 2600
  158. 1670 IF F1<21 AND Y<F   THEN GOSUB 1760:Y=Y+1:F1=F1+2:GOTO 2560
  159. 1680 IF F>10  AND Y<F   THEN GOSUB 1790:Y=Y+1:GOTO 2560
  160. 1690 GOTO 2600
  161. 1700 IF V1>4  AND X<=10 THEN GOSUB 1760:X=X-1:V1=V1-2:GOTO 2560
  162. 1710 IF V1>4  AND X>1   THEN X=X-1:GOSUB 1840:GOTO 2560
  163. 1720 GOTO 2600
  164. 1730 IF V1<22 AND X<V   THEN GOSUB 1760:X=X+1:V1=V1+2:GOTO 2560
  165. 1740 IF V>10  AND X<V   THEN X=X+1:GOSUB 1840:GOTO 2560
  166. 1750 GOTO 2600
  167. 1760 IF ABS(Z(DA,Y,X))>1E-5 THEN SYS AT,V1,F1,B5$" ":RETURN
  168. 1770 SYS AT,V1,F1,B4$" ":RETURN
  169. 1780 :
  170. 1790 Y1=Y-9
  171. 1800 FOR I=3 TO 21 STEP 2
  172. 1810 SYS AT,1,I,B0$;MID$(F1$,Y1*2+1,2):Y1=Y1+1:NEXT I
  173. 1820 RETURN
  174. 1830 :
  175. 1840 IF X<=10 THEN 1890
  176. 1850 SYS AT,4,0,B0$;MID$(V1$,X*2-19,19)
  177. 1860 SYS AT,4,1,B0$;MID$(V2$,X*2-19,19)
  178. 1870 RETURN
  179. 1880 :
  180. 1890 SYS AT,4,0,B0$;MID$(V1$,1,19)
  181. 1900 SYS AT,4,1,B0$;MID$(V2$,1,19)
  182. 1910 RETURN
  183. 1920 :
  184. 1930 REM CLEAR
  185. 1940 :
  186. 1950 SYS AT,26,7,B3$;B9$
  187. 1960 GET A$:IF A$=""THEN 1960
  188. 1970 IF A$="X" THEN 2040
  189. 1980 IF A$="Y" THEN 2140
  190. 1990 IF A$="Q" THEN 2090
  191. 2000 GOTO 1960
  192. 2010 :
  193. 2020 REM CLEAR X
  194. 2030 :
  195. 2040 IF MX=0 THEN F$="X":GOSUB 6580:GOTO 2090
  196. 2050 SYS AT,26,7,B3$"    "B4$"CLEAR X"
  197. 2060 CL=1:GOSUB 6770:IF A$="N" THEN 2090
  198. 2070 KX=MX:KY=NX:XY=5:DA=MA:P=MX:R=NX:GOSUB 5360
  199. 2080 GOSUB 6410
  200. 2090 SYS AT,26,7,B3$"C = CLEAR  "
  201. 2100 GOTO 780
  202. 2110 :
  203. 2120 REM CLEAR Y
  204. 2130 :
  205. 2140 IF MY=0 THEN F$="Y":GOSUB 6580:GOTO 2090
  206. 2150 SYS AT,26,7,B3$"    "B4$"CLEAR Y"
  207. 2160 CL=1:GOSUB 6770:IF A$="N" THEN 2190
  208. 2170 KX=MY:KY=NY:XY=5:DA=TR:P=MY:R=NY:GOSUB 5360
  209. 2180 GOSUB 6410
  210. 2190 GOTO 2090
  211. 2200 :
  212. 2210 REM DATEN EINGABE
  213. 2220 :
  214. 2230 SYS AT,26,5,B3$;B9$:O=5
  215. 2240 GET A$:IF A$=""THEN 2240
  216. 2250 IF A$="X" THEN 2320
  217. 2260 IF A$="Y" THEN 2420
  218. 2270 IF A$="Q" THEN 2370
  219. 2280 GOTO 2240
  220. 2290 :
  221. 2300 REM DATA X
  222. 2310 :
  223. 2320 IF MX=0 THEN F$="X":GOSUB 6580:GOTO 2370
  224. 2330 SYS AT,26,5,B3$"    "B4$"DATA X ":SYS AT,1,0,"X"
  225. 2340 KX=MX:KY=NX:GOSUB 6410:GOSUB 6460
  226. 2350 F=MX:V=NX
  227. 2360 DA=MA:GOSUB 2500
  228. 2370 SYS AT,26,5,B3$"D = DATA    "
  229. 2380 GOTO 780
  230. 2390 :
  231. 2400 REM DATA Y
  232. 2410 :
  233. 2420 IF MY=0 THEN F$="Y":GOSUB 6580:GOTO 2370
  234. 2430 SYS AT,26,5,B3$"    "B4$"DATA Y ":SYS AT,1,0,"Y"
  235. 2440 F=MY:V=NY:KX=MY:KY=NY:GOSUB 6410:GOSUB 6460
  236. 2450 DA=TR:GOSUB 2500
  237. 2460 SYS AT,26,5,B3$"D = DATA    "
  238. 2470 IF MX<>0 THEN F=MX:V=NX:KX=MX:KY=NX:GOSUB 6410:GOSUB 6460:SYS AT,1,0,"X"
  239. 2480 GOTO 780
  240. 2490 :
  241. 2500 F1=3:V1=4:SA=15
  242. 2510 GOSUB 1890
  243. 2520 Y1=0:GOSUB 1800
  244. 2530 FOR Y=1 TO F
  245. 2540 FOR X=1 TO V
  246. 2550 IF X>=10 THEN V1=22:GOSUB 1840
  247. 2560 SYS AT,V1,F1,"?"
  248. 2570 GOSUB 1610
  249. 2580 M$=STR$(FNE(Z(DA,Y,X)))
  250. 2590 SYS AT,3,23,B0$;"X=";M$
  251. 2600 GET N$:IF N$="" THEN 2600
  252. 2610 IF ASC(N$)=45 OR ASC(N$)=46 THEN 2630
  253. 2620 IF ASC(N$)<48 OR ASC(N$)>57 THEN 2650
  254. 2630 M$="":SZ=0:GOSUB 1550:Z(DA,Y,X)=VAL(M$)
  255. 2640 IF ASC(N$)= 13 THEN 2720
  256. 2650 IF ASC(N$)=147 OR ASC(N$)=19 THEN GOSUB 1890:GOTO 2800
  257. 2660 IF ASC(N$)=145 THEN 1640
  258. 2670 IF ASC(N$)= 17 THEN 1670
  259. 2680 IF ASC(N$)=157 THEN 1700
  260. 2690 IF ASC(N$)= 29 THEN 1730
  261. 2700 IF ASC(N$)= 13 THEN 2720
  262. 2710 GOTO  2600
  263. 2720 GOSUB 1760
  264. 2730 V1=V1+2
  265. 2740 NEXT X
  266. 2750 GOSUB 1890
  267. 2760 V1=4
  268. 2770 F1=F1+2
  269. 2780 IF Y>=10 AND Y<F THEN F1=21:GOSUB 1790
  270. 2790 NEXT Y
  271. 2800 Y1=0:GOSUB 1800
  272. 2810 GOSUB 6550:GOSUB 6460
  273. 2820 RETURN
  274. 2830 :
  275. 2840 REM M=X
  276. 2850 :
  277. 2860 IF MX=0 THEN F$="X":GOSUB 6580:GOTO 2920
  278. 2870 SYS AT,30,13,B4$"X   [192]>M"
  279. 2880 MM=MX:NM=NX
  280. 2890 FOR X=1 TO MX
  281. 2900 FOR Y=1 TO NX
  282. 2910 M(0,X,Y)=Z(MA,X,Y):NEXT Y:NEXT X
  283. 2920 SYS AT,30,13,B3$"X   [192]>M"
  284. 2930 GOTO 780
  285. 2940 :
  286. 2950 REM X=M
  287. 2960 :
  288. 2970 IF MM=0 THEN F$="M":GOSUB 6580:GOTO 3050
  289. 2980 SYS AT,30,15,B4$"M   [192]>X":SYS AT,1,0,"X"
  290. 2990 GOSUB 6410
  291. 3000 MX=MM:NX=NM
  292. 3010 KX=MM:KY=NM:GOSUB 6460
  293. 3020 FOR X=1 TO MM
  294. 3030 FOR Y=1 TO NM
  295. 3040 Z(MA,X,Y)=M(0,X,Y):NEXT Y:NEXT X
  296. 3050 SYS AT,30,15,B3$"M   [192]>X"
  297. 3060 GOTO 780
  298. 3070 :
  299. 3080 REM X=X+M
  300. 3090 :
  301. 3100 IF MM=0 THEN F$="M":GOSUB 6580:GOTO 3190
  302. 3110 SYS AT,30,17,B4$"X+M [192]>M":SYS AT,1,0,"X"
  303. 3120 IF MM=MX OR NM=NX THEN 3140
  304. 3130 GOSUB 6620:GOTO 3190
  305. 3140 FOR X=1 TO MM
  306. 3150 FOR Y=1 TO NM
  307. 3160 M(0,X,Y)=M(0,X,Y)+Z(MA,X,Y)
  308. 3170 NEXT Y
  309. 3180 NEXT X
  310. 3190 SYS AT,30,17,B3$"X+M [192]>M"
  311. 3200 GOTO 780
  312. 3210 :
  313. 3220 REM VERTAUSCHEN VON X,Y
  314. 3230 :
  315. 3240 IF MX=0 AND MY=0 THEN F$="":GOSUB 6580:GOTO 3300
  316. 3250 SYS AT,30,19,B4$"X< [192] >Y":SYS AT,1,0,"X"
  317. 3260 C=MA:MA=TR:TR=C
  318. 3270 C=MX:MX=MY:MY=C:C=NX:NX=NY:NY=C
  319. 3280 KX=MX:KY=NX:GOSUB 6410
  320. 3290 IF MX<>0 THEN GOSUB 6460
  321. 3300 SYS AT,30,19,B3$"X< [192] >Y"
  322. 3310 GOTO 780
  323. 3320 :
  324. 3330 REM DREHEN
  325. 3340 :
  326. 3350 IF MX=0 THEN F$="X":GOSUB 6580:GOSUB 6860:GOTO 780
  327. 3360 SYS AT,26,21,B3$"Q   _ ?  ^?"
  328. 3370 GET A$:IF A$="" THEN 3370
  329. 3380 IF A$="_" THEN SYS AT,26,21,B3$"    "B4$"_"B3$"       ":GOTO 3420
  330. 3390 IF A$="^" THEN SYS AT,26,21,B3$"         "B4$"^"B3$"  ":GOTO 3460
  331. 3400 IF A$="Q" THEN 3550
  332. 3410 GOTO 3370
  333. 3420 IF MX<>NX THEN GOSUB 6530:GOSUB 6740:GOTO 3550
  334. 3430 G=MX
  335. 3440 FOR X=1 TO MX:FOR Y=1 TO MX:C(X,Y)=Z(MA,X,Y):NEXT Y:NEXT X
  336. 3450 FOR X=1 TO MX:FOR Y=1 TO MX:Z(MA,X,Y)=C(Y,G):NEXT Y:G=G-1:NEXT X
  337. 3460 GOSUB 3470:GOTO 3550
  338. 3470 KX=MX:KY=NX:X=1:Y=1
  339. 3480 IF KX>10 THEN KX=10
  340. 3490 IF KY>10 THEN KY=10
  341. 3500 FOR F1=3 TO 2+2*KX STEP 2
  342. 3510 FOR V1=4 TO 3+2*KY STEP 2
  343. 3520 IF ABS(Z(MA,X,Y))>1E-5 THEN SYS AT,V1,F1,B5$" ":GOTO 3540
  344. 3530 SYS AT,V1,F1,B4$" "
  345. 3540 Y=Y+1:NEXT V1:Y=1:X=X+1:NEXT F1:RETURN
  346. 3550 SYS AT,26,21,B3$"_ = DREHEN X"
  347. 3560 GOTO 910
  348. 3570 :
  349. 3580 REM VERTAUSCHEN DER VORZEICHEN
  350. 3590 :
  351. 3600 IF MX=0 THEN F$="X":GOSUB 6580:GOTO 3650
  352. 3610 SYS AT,30,21,B4$"+/- [192]>X"
  353. 3620 FOR X=1 TO MX
  354. 3630 FOR Y=1 TO NX
  355. 3640 Z(MA,X,Y)=Z(MA,X,Y)*-1:NEXT Y:NEXT X
  356. 3650 SYS AT,30,21,B3$"+/- [192]>X"
  357. 3660 GOTO 780
  358. 3670 :
  359. 3680 REM X=X+Y
  360. 3690 :
  361. 3700 IF MX=0 OR MY=0 THEN F$="X ODER Y":GOSUB 6580:GOSUB 6860:GOTO 780
  362. 3710 IF MX<>MY OR NX<>NY THEN GOSUB 6530:GOSUB 6620:GOTO 3780
  363. 3720 SYS AT,30,3,B4$"X+Y  [192]>X":SYS AT,1,0,"X"
  364. 3730 FOR X=1 TO MX
  365. 3740 FOR Y=1 TO NX
  366. 3750 Z(MA,X,Y)=Z(MA,X,Y)+Z(TR,X,Y)
  367. 3760 NEXT Y
  368. 3770 NEXT X
  369. 3780 SYS AT,30,3,B3$"X+Y  [192]>X"
  370. 3790 GOTO 910
  371. 3800 :
  372. 3810 REM X=X-Y
  373. 3820 :
  374. 3830 IF MX=0 OR MY=0 THEN F$="X ODER Y":GOSUB 6580:GOSUB 6860:GOTO 780
  375. 3840 IF MX<>MY OR NX<>NY THEN GOSUB 6530:GOSUB 6620:GOTO 3910
  376. 3850 SYS AT,30,5,B4$"X-Y  [192]>X":SYS AT,1,0,"X"
  377. 3860 FOR X=1 TO MX
  378. 3870 FOR Y=1 TO NX
  379. 3880 Z(MA,X,Y)=Z(MA,X,Y)-Z(TR,X,Y)
  380. 3890 NEXT Y
  381. 3900 NEXT X
  382. 3910 SYS AT,30,5,B3$"X-Y  [192]>X"
  383. 3920 GOTO 910
  384. 3930 :
  385. 3940 REM X=X*Y
  386. 3950 :
  387. 3960 IF MX=0 OR MY=0 THEN F$="X ODER Y":GOSUB 6580:GOSUB 6860:GOTO 780
  388. 3970 SYS AT,30,7,B4$"X*Y  [192]>X"
  389. 3980 GOSUB 6240
  390. 3990 GOSUB 6410
  391. 4000 K=K+1:IF K=2 THEN K=0:GOSUB 6860:GOSUB 3470:GOTO 2350
  392. 4010 KX=MX:KY=NX:GOSUB 6460
  393. 4020 SYS AT,30,7,B3$"X*Y  [192]>X":SYS AT,1,0,"X":K=0
  394. 4030 GOTO 910
  395. 4040 :
  396. 4050 REM DETERMINANTE
  397. 4060 :
  398. 4070 IF MX=0 THEN F$="X":GOSUB 6580:GOSUB 6860:GOTO 780
  399. 4080 IF MX<>NX THEN GOSUB 6530:GOSUB 6740:GOTO 910
  400. 4090 SYS AT,30,17,B4$"DETERM.X"
  401. 4100 IF MX=1 AND NX=1 THEN DE=Z(MA,1,1):GOTO 4120
  402. 4110 XY=1:P=MX:R=NX:GOSUB 6030
  403. 4120 SYS AT,3,23,B0$"DETERMINANTE=";DE
  404. 4130 SYS AT,30,17,B3$"DETERM.X"
  405. 4140 GET A$:IF A$="" THEN 4140
  406. 4150 GOSUB 6550
  407. 4160 GOTO 920
  408. 4170 :
  409. 4180 REM REZIPROKWERT VON X
  410. 4190 :
  411. 4200 IF MX=0 THEN F$="X":GOSUB 6580:GOSUB 6860:GOTO 780
  412. 4210 IF MX<>NX THEN GOSUB 6530:GOSUB 6740:GOTO 910
  413. 4220 SYS AT,30,13,B4$"INVERS X":SYS AT,1,0,"X"
  414. 4230 XY=1:DA=MA:IN=MX:P=MX:R=NX:GOSUB 4740
  415. 4240 SYS AT,30,13,B3$"INVERS X":SYS AT,1,0,"X"
  416. 4250 GOTO 910
  417. 4260 :
  418. 4270 REM X=X/Y
  419. 4280 :
  420. 4290 IF MX=0 OR MY=0 THEN F$="X ODER Y":GOSUB 6580:GOSUB 6860:GOTO 780
  421. 4300 IF MY<>NY THEN GOSUB 6530:GOSUB 6740:GOTO 4420
  422. 4310 IF NX<>NY THEN GOSUB 6530:GOSUB 6620:GOTO 4420
  423. 4320 SYS AT,30,9,B4$"X*IY ->X"
  424. 4330 :
  425. 4340 XY=2:DA=TR:IN=MY:P=MY:R=NY
  426. 4350 FOR X=1 TO MY:FOR Y=1 TO NY:M(1,X,Y)=Z(TR,X,Y):NEXT Y:NEXT X
  427. 4360 GOSUB 4740
  428. 4370 GOSUB 6240
  429. 4380 P=MY:R=NY
  430. 4390 FOR X=1 TO MY:FOR Y=1 TO NY:Z(TR,X,Y)=M(1,X,Y):NEXT Y:NEXT X
  431. 4400 GOSUB 6410
  432. 4410 KX=MX:KY=NX:GOSUB 6460
  433. 4420 SYS AT,30,9,B3$"X*IY ->X":SYS AT,1,0,"X"
  434. 4430 GOTO 910
  435. 4440 :
  436. 4450 REM SUBRUTIN ZUM REZIPROKWERT
  437. 4460 :
  438. 4470 K=1:FOR X=1 TO CX
  439. 4480 C(X,X)=C(X,X)+1
  440. 4490 NEXT X
  441. 4500 B=CX
  442. 4510 H=B
  443. 4520 D=C(H,H)-1
  444. 4530 IF D=0 THEN K=0:RETURN
  445. 4540 GOSUB 4620
  446. 4550 B=B-1
  447. 4560 IF B>0 THEN 4510
  448. 4570 FOR X=1 TO CX
  449. 4580 C(X,X)=C(X,X)-1
  450. 4590 NEXT X
  451. 4600 RETURN
  452. 4610 :
  453. 4620 FOR F=1 TO CX
  454. 4630 H=B
  455. 4640 C(H,F)=C(H,F)/D
  456. 4650 NEXT F
  457. 4660 FOR E=1 TO CX
  458. 4670 IF B=E THEN 4720
  459. 4680 H=B:D=C(E,B)
  460. 4690 FOR F=1 TO CX
  461. 4700 C(E,F)=C(E,F)-D*C(B,F)
  462. 4710 NEXT F
  463. 4720 NEXT E:RETURN
  464. 4730 :
  465. 4740 W=0:CX=IN:DR=0:GOSUB 5360:IF IN=1 THEN GOSUB 4470:GOTO 4960
  466. 4750 FOR I=IN-1 TO 2 STEP-1
  467. 4760 IF C(I,I)=0 OR ABS(C(I,I))<ABS(C(I-1,I))THEN 4790
  468. 4770 NEXT I
  469. 4780 GOTO 4800
  470. 4790 DR=1:GOSUB 5410
  471. 4800 FOR X=0 TO IN-1:W(X)=0:NEXT X
  472. 4810 IF C(1 , 1)=0 THEN GOSUB 4990
  473. 4820 IF C(IN,IN)=0 THEN GOSUB 5080
  474. 4830 IF IN>2 THEN GOSUB 5220
  475. 4840 GOSUB 4470
  476. 4850 IF K=0 THEN GOSUB 6830:RETURN
  477. 4860 IF IN<3 THEN 4930
  478. 4870 FOR I=2 TO IN-1
  479. 4880 FOR X=1 TO IN
  480. 4890 IF W(I)=0 THEN 4910
  481. 4900 C=C(X,W(I)):C(X,W(I))=C(X,I):C(X,I)=C
  482. 4910 NEXT X
  483. 4920 NEXT I
  484. 4930 IF W(1)<>0 THEN PV=1:W=IN:GOSUB 5170
  485. 4940 IF W(0)<>0 THEN PV=0:W=1:GOSUB 5170
  486. 4950 IF DR<>0 THEN GOSUB 5410
  487. 4960 XY=XY+2:GOSUB 5360:XY=XY-2
  488. 4970 RETURN
  489. 4980 :
  490. 4990 FOR X=1 TO IN
  491. 5000 IF C(1,X)=0 THEN 5020
  492. 5010 W(0)=X:GOTO 5030
  493. 5020 NEXT X
  494. 5030 FOR X=1 TO IN
  495. 5040 C=C(X,W(0)):C(X,W(0))=C(X,1):C(X,1)=C
  496. 5050 NEXT X
  497. 5060 RETURN
  498. 5070 :
  499. 5080 FOR X=IN TO 1 STEP-1
  500. 5090 IF C(IN,X)=0THEN 5110
  501. 5100 W(1)=X:GOTO 5120
  502. 5110 NEXT X
  503. 5120 FOR X=1 TO IN
  504. 5130 C=C(X,W(1)):C(X,W(1))=C(X,IN):C(X,IN)=C
  505. 5140 NEXT X
  506. 5150 RETURN
  507. 5160 :
  508. 5170 FOR X=1 TO IN
  509. 5180 C=C(W(PV),X):C(W(PV),X)=C(W,X):C(W,X)=C
  510. 5190 NEXT X
  511. 5200 RETURN
  512. 5210 :
  513. 5220 FOR I=IN-1 TO 2 STEP-1
  514. 5230 IF C(I,I)=0 OR ABS(C(I,I))<ABS(C(I-1,I)) THEN 5250
  515. 5240 GOTO 5330
  516. 5250 FOR X=I-1 TO 1 STEP-1
  517. 5260 IF C(X,I)=0 OR ABS(C(X,I))<ABS(C(X+1,I)) THEN 5320
  518. 5270 W(I)=X
  519. 5280 FOR Y=1 TO IN
  520. 5290 C=C(X,Y):C(X,Y)=C(I,Y):C(I,Y)=C
  521. 5300 NEXT Y
  522. 5310 X=1
  523. 5320 NEXT X
  524. 5330 NEXT I
  525. 5340 RETURN
  526. 5350 :
  527. 5360 FOR X=1 TO P:FOR Y=1 TO R
  528. 5370 ON XY GOSUB 5470,5480,5490,5500,5510
  529. 5380 NEXT Y:NEXT X
  530. 5390 RETURN
  531. 5400 :
  532. 5410 G=IN:FOR X=1 TO IN:FOR Y=1 TO IN
  533. 5420 Z(DA,X,Y)=C(Y,G)
  534. 5430 NEXT Y:G=G-1:NEXT X
  535. 5440 GOSUB 5360
  536. 5450 RETURN
  537. 5460 :
  538. 5470 C(X,Y)=Z(MA,X,Y):RETURN
  539. 5480 C(X,Y)=Z(TR,X,Y):RETURN
  540. 5490 Z(MA,X,Y)=C(X,Y):RETURN
  541. 5500 Z(TR,X,Y)=C(X,Y):RETURN
  542. 5510 Z(DA,X,Y)=0:RETURN
  543. 5520 :
  544. 5530 REM TRANSPOSITION
  545. 5540 :
  546. 5550 IF MX=0 THEN F$="X":GOSUB 6580:GOSUB 6860:GOTO 780
  547. 5560 SYS AT,30,15,B4$"TRANSP.X"
  548. 5570 XY=1:P=MX:R=NX:GOSUB 5360
  549. 5580 FOR X=1 TO MX
  550. 5590 FOR Y=1 TO NX
  551. 5600 Z(MA,Y,X)=C(X,Y)
  552. 5610 NEXT Y
  553. 5620 NEXT X
  554. 5630 C=MX:MX=NX:NX=C
  555. 5640 GOSUB 6410
  556. 5650 KX=MX:KY=NX:GOSUB 6460
  557. 5660 SYS AT,30,15,B3$"TRANSP.X":SYS AT,1,0,"X"
  558. 5670 GOTO 910
  559. 5680 :
  560. 5690 REM SKALAR OPERATION
  561. 5700 :
  562. 5710 IF MX=0 THEN F$="X":GOSUB6580:GOSUB6860:GOTO 780
  563. 5720 SYS AT,26,19,B3$"Q   ";B8$
  564. 5730 GET A$:IF A$="" THEN 5730
  565. 5740 IF A$="+"THEN U=1:W=1:GOTO 5810
  566. 5750 IF A$="-"THEN U=2:W=3:GOTO 5810
  567. 5760 IF A$="*"THEN U=3:W=5:GOTO 5810
  568. 5770 IF A$="/"THEN U=3:GOTO 5860
  569. 5780 IF A$="Q"THEN GOTO 5980
  570. 5790 GOTO 5730
  571. 5800 :
  572. 5810 SYS AT,29+W,19,B4$;MID$(B8$,W,1):GOSUB 5910
  573. 5820 FOR X=1 TO MX:FOR Y=1 TO NX
  574. 5830 ON U GOSUB 5950,5960,5970
  575. 5840 NEXT Y:NEXT X
  576. 5850 GOTO 5980
  577. 5860 SYS AT,36,19,B4$"/":GOSUB 5910
  578. 5870 XY=1:DA=MA:IN=MX:P=MX:R=NX
  579. 5880 GOSUB 4740
  580. 5890 GOTO 5820
  581. 5900 :
  582. 5910 SYS AT,3,23,B0$"SKALAR=":SA=15:O=10:GOSUB 1490
  583. 5920 N=VAL(M$)
  584. 5930 GOSUB 6550:RETURN
  585. 5940 :
  586. 5950 Z(MA,X,Y)=N+Z(MA,X,Y):RETURN
  587. 5960 Z(MA,X,Y)=N-Z(MA,X,Y):RETURN
  588. 5970 Z(MA,X,Y)=N*Z(MA,X,Y):RETURN
  589. 5980 SYS AT,26,19,B3$"S = SKALAR X"
  590. 5990 GOTO 910
  591. 6000 :
  592. 6010 REM SUBRUTIN ZUR DETERMINANTE
  593. 6020 :
  594. 6030 GOSUB 5360
  595. 6040 K=0:B=P:E=1
  596. 6050 I=B
  597. 6060 D=C(I,I):IF D=0 THEN GOSUB 6110
  598. 6070 IF K=1 THEN E=0:GOTO 6100
  599. 6080 E=D*E:GOSUB 6180
  600. 6090 B=B-1:IF B>1 THEN 6050
  601. 6100 E=E*C(1,1):DE=E:RETURN
  602. 6110 FOR F=1 TO B-1
  603. 6120 D=C(F,I):IF D<>0 THEN 6160
  604. 6130 NEXT F
  605. 6140 K=1
  606. 6150 RETURN
  607. 6160 FOR G=1 TO B:C(I,G)=C(I,G)+C(F,G):NEXT G
  608. 6170 RETURN
  609. 6180 FOR F=1 TO B-1:L=C(F,I)/D:FOR G=1 TO B-1:C(F,G)=C(F,G)-L*C(I,G)
  610. 6190 NEXT G:NEXT F
  611. 6200 RETURN
  612. 6210 :
  613. 6220 REM SUBRUTIN ZUM PRODUKT
  614. 6230 :
  615. 6240 IF NX<>MY THEN GOSUB 6530:GOSUB 6670:RETURN
  616. 6250 FOR X=1 TO MX
  617. 6260 FOR Y=1 TO NY
  618. 6270 C(X,Y)=0
  619. 6280 FOR Z=1 TO NX
  620. 6290 C(X,Y)=C(X,Y)+Z(MA,X,Z)*Z(TR,Z,Y)
  621. 6300 NEXT Z
  622. 6310 NEXT Y
  623. 6320 NEXT X
  624. 6330 XY=3:P=MX:R=NY:GOSUB 5360
  625. 6340 NX=NY
  626. 6350 RETURN
  627. 6360 :
  628. 6370 GOSUB 6530
  629. 6380 SYS AT,3,23,B0$"DEFINITION 1-20"
  630. 6390 GOTO 6540
  631. 6400 :
  632. 6410 FOR Y=3 TO 2+2*10 STEP 2
  633. 6420 FOR X=4 TO 3+2*10 STEP 2
  634. 6430 SYS AT,X,Y," ":NEXT X:NEXT Y
  635. 6440 RETURN
  636. 6450 :
  637. 6460 IF KX>10 THEN KX=10
  638. 6470 IF KY>10 THEN KY=10
  639. 6480 FOR Y=3 TO 2+2*KX STEP 2
  640. 6490 FOR X=4 TO 3+2*KY STEP 2
  641. 6500 SYS AT,X,Y,B6$" ":NEXT X:NEXT Y
  642. 6510 RETURN
  643. 6520 :
  644. 6530 SYS AT,3,23,B0$"ERROR !!         "
  645. 6540 FOR I=1 TO 2000:NEXT I
  646. 6550 SYS AT,3,23,B0$"                                   "
  647. 6560 RETURN
  648. 6570 :
  649. 6580 SYS AT,3,23,B0$"KEINE DEFINITION IN MATRIX ";F$
  650. 6590 GOSUB 6540
  651. 6600 RETURN
  652. 6610 :
  653. 6620 SYS AT,3,23,B0$"MATRIZEN VERSCHIEDENEN FORMATS"
  654. 6630 GOSUB 6540
  655. 6640 RETURN
  656. 6650 :
  657. 6660 GOSUB 6530
  658. 6670 SYS AT,3,23,B0$"(N) IN MATRIX X UND (M) IN MATRIX Y":FOR I=1 TO 900:NEXT I
  659. 6680 GOSUB 6540
  660. 6690 SYS AT,3,23,B0$"SIND UNGLEICH"
  661. 6700 GOSUB 6540
  662. 6710 RETURN
  663. 6720 :
  664. 6730 GOSUB 6530
  665. 6740 SYS AT,3,23,B0$"MATRIZ IST NICHT QUADRATISCH"
  666. 6750 GOTO 6700
  667. 6760 :
  668. 6770 SYS AT,3,23,B0$"SIND SIE SICHER ? J/N"
  669. 6780 GET A$:IF A$=""THEN 6780
  670. 6790 IF A$="J" AND CL=0 THEN GOSUB 6550:POKE 788,49:PRINT"[145][145][145]":END
  671. 6800 IF A$="J" AND CL=1 THEN GOSUB 6550:RETURN
  672. 6810 IF A$="N" THEN GOSUB 6550:RETURN
  673. 6820 GOTO 6780
  674. 6830 SYS AT,3,23,B0$"MATRIX IST SINGULAER"
  675. 6840 GOTO 6700
  676. 6850 :
  677. 6860 SYS AT,26,3,B3$"I = MATRIX  "
  678. 6870 SYS AT,26,5,B3$"D = DATA    "
  679. 6880 SYS AT,26,7,B3$"C = CLEAR   "
  680. 6890 SYS AT,26,9,B3$"E = MENUE II"
  681. 6900 SYS AT,26,11,B3$"Q = QUIT    "
  682. 6910 SYS AT,26,13,B3$"M = X   [192]>M "
  683. 6920 SYS AT,26,15,B3$"R = M   [192]>X "
  684. 6930 SYS AT,26,17,B3$"S = X+M [192]>M "
  685. 6940 SYS AT,26,19,B3$"W = X< [192] >Y "
  686. 6950 SYS AT,26,21,B3$"- = +/- [192]>X "
  687. 6960 RETURN
  688. 6970 SYS AT,26,3,B3$"+ = X+Y  [192]>X"
  689. 6980 SYS AT,26,5,B3$"- = X-Y  [192]>X"
  690. 6990 SYS AT,26,7,B3$"* = X*Y  [192]>X"
  691. 7000 SYS AT,26,9,B3$"/ = X*IY [192]>X"
  692. 7010 SYS AT,26,13,B3$"I = INVERS X"
  693. 7020 SYS AT,26,15,B3$"T = TRANSP.X"
  694. 7030 SYS AT,26,17,B3$"D = DETERM.X"
  695. 7040 SYS AT,26,19,B3$"S = SKALAR X"
  696. 7050 SYS AT,26,21,B3$"_ = DREHEN X"
  697. 7060 RETURN
  698.